home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / DEMONSTR / ATEASY_2.ZIP / ATEZDLL.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-01  |  6KB  |  176 lines
  1. {****************************************************************************
  2.  
  3.     PROGRAM: ATEZDLL.pas
  4.                           
  5.     BY     : Ronnie Yazma, Copyright 1993 GEOTEST Inc.   
  6.                           
  7.     PURPOSE: Demonstarte ATEasy type DLL functions using TPW 
  8.     
  9.     TO COMPILE:
  10.              Use Turbo pascal for window. 
  11.  
  12.     VERSION: 2.00 (Jul-26-93)
  13.  
  14.     FUNCTIONS/SUBROUTINES:
  15.  
  16.          - MaxSub() : finds the max between 2 floats
  17.          - MaxLongFunc() : return the max between 2 floats
  18.          - AverageArray() : find the avarage of float array
  19.          - NoSpaces() : delete leading & trailing spaces in a string
  20.          - UCase2Dim() : convert 2 dim string to upper case
  21.          
  22. ****************************************************************************}
  23. {$N+}                       { Must be on for ATEasy Types }
  24. {$M 1024, 1024}
  25.  
  26. library ATEZDLL;
  27. uses wintypes;              { Must be included for windows types }
  28.  
  29. {$I ateasydl}               { Contains ATEasy VAL, VAR parameters definitions
  30.  
  31. {****************************************************************************
  32.  
  33.     FUNCTION: MaxSub(hWnd, dX1, dX2, lpdResult)
  34.  
  35.     PURPOSE:  Finds the max of 2 floats (dX1 & dX2) into lpdResult.
  36.  
  37.        This subroutine defined in ATEasy as:
  38.        Max(fX1: VAL FLOAT, fX2: VAL FLOAT, fResult: VAR FLOAT): SUB DLL
  39.  
  40. ****************************************************************************}
  41. procedure MaxSub(hWnd : HWND; dX1, dX2 : VAL_FLOAT; lpdResult : VAR_FLOAT); export;
  42. begin
  43.     if dX1 < dX2 then
  44.         lpdResult^:=dX2
  45.     else
  46.         lpdResult^:=dX1;
  47. end;
  48.  
  49. {****************************************************************************
  50.  
  51.     FUNCTION: MaxLongFunc(hWnd, lX1, lX2)
  52.  
  53.     PURPOSE:  Returns the max of 2 longs (lX1 & lX2).
  54.               Note that this is a function. 
  55.  
  56.        This function defined in ATEasy as:
  57.        Long Max(lX1: VAL LONG, lX2: VAL LONG): Function DLL
  58.  
  59. ****************************************************************************}
  60. function MaxLongFunc(hWnd : HWND; lX1, lX2 : VAL_LONG):longint; export; 
  61. begin   
  62.     if lX1 < lX2 then
  63.         MaxLongFunc:=lX2
  64.     else
  65.         MaxLongFunc:=lX1;
  66. end;
  67.  
  68. {****************************************************************************
  69.  
  70.     FUNCTION: AverageArray(hWnd, vafNumbers, lpdResult)
  71.  
  72.     PURPOSE:  Calculate the mean value of vafNumbers array into lpdResult.
  73.  
  74.         This function defined in ATEasy as:
  75.         AverageArray(afNumbers : VAL FLOAT[], dResult : VAR FLOAT) : SUB DLL
  76.  
  77. ****************************************************************************}
  78. procedure AverageArray(hWnd : HWND; vafNumbers : VAL_AFLOAT; lpdResult : VAR_FLOAT); export;
  79. var
  80.     dTResult : double;
  81.     i : integer;
  82. begin
  83.     dTResult:=0.0;
  84.     for i:=1 to vafNumbers^.nDim2 do
  85.     dTResult:=dTResult+vafNumbers^.lpFloat^[i];
  86.     if vafNumbers^.nDim2 <> 0 then
  87.     dTResult:=dTResult / vafNumbers^.nDim2;
  88.     lpdResult^:=dTResult;
  89. end;
  90.  
  91. {****************************************************************************
  92.  
  93.     FUNCTION: NoSpaces(hWnd, vsString)
  94.  
  95.     PURPOSE:  Delete leading & trailing spaces in a string
  96.  
  97.         This function defined in ATEasy as:
  98.         NoSpaces(s : VAR String)
  99.  
  100. ****************************************************************************}
  101. procedure NoSpaces(hWnd : HWND; vsString : VAR_ASTRING); export;
  102. var
  103.     i, j : integer;
  104. begin
  105.     i:=vsString^.lpString^.nLen;
  106.     while (i > 0) and (vsString^.lpString^.lp[i] = ' ') do
  107.     dec(i);
  108.     vsString^.lpString^.nLen:=i;   { delete trailing spaces }
  109.     j:=1;
  110.     while (j <= i) and (vsString^.lpString^.lp[j] = ' ') do
  111.         inc(j);
  112.     if (j > 1) then                { move to start }
  113.     begin
  114.          dec(vsString^.lpString^.nLen, j-1);
  115.     move(vsString^.lpString^.lp[j], vsString^.lpString^.lp, vsString^.lpString^.nLen);
  116.     end;
  117. end;
  118.  
  119. {****************************************************************************
  120.  
  121.     FUNCTION: UCase2Dim(hWnd, vasStrings)
  122.  
  123.     PURPOSE:  convert 2 dim string to upper case
  124.  
  125.         This function defined in ATEasy as:
  126.         UCase2Dim(as : VAR String[,])
  127.  
  128.     COMMENT : You can use the strings unit and the PChar type
  129.               when dealling with strings in a much more elegant way.    
  130.  
  131. ****************************************************************************}
  132. procedure UCase2Dim(hWnd : HWND; vasStrings : VAR_ASTRING); export;
  133. type
  134.     CHARARRAY = array[1..32767] of char; 
  135. var
  136.     i, j   : integer;
  137.     lpnLen : ^integer;
  138.     lp     : ^CHARARRAY;
  139.  
  140. begin
  141.     for i:=1 to vasStrings^.nDim1 do
  142.     begin
  143.         { get the i string }
  144.         lp:=@vasStrings^.lpString^.lp[(i-1)*(vasStrings^.nDim2+2)+1];
  145.                      
  146.         { get the string length }
  147. {$IFOPT R+}
  148.         { if range checking is on the array index must be positive }   
  149.         if (i=1) then              
  150.             lpnLen:=@vasStrings^.lpString^.nLen
  151.         else
  152. {$ENDIF}
  153.             lpnLen:=@vasStrings^.lpString^.lp[(i-1)*(vasStrings^.nDim2+2)-1];     
  154.         for j:=1 to lpnLen^ do
  155.             lp^[j]:=UpCase(lp^[j]);      { convert to upper case }
  156.     end;     
  157. end;
  158.  
  159. {****************************************************************************
  160.             Exports definition for the DLL
  161. ****************************************************************************}
  162.  
  163. exports  MaxSub            index 100;
  164. exports  MaxLongFunc       index 101;
  165. exports  AverageArray      index 102;
  166. exports  NoSpaces       index 103;
  167. exports  UCase2Dim       index 104;
  168.  
  169. begin
  170.     { Note:You can place here initialization code for your dll }
  171. end.
  172.  
  173. {****************************************************************************
  174.             E - O - F
  175. ****************************************************************************}
  176.